home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / s-valuti.adb < prev    next >
Text File  |  1996-01-30  |  6KB  |  235 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT COMPILER COMPONENTS                         --
  4. --                                                                          --
  5. --                      S Y S T E M . V A L _ U T I L                       --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.4 $                              --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. package body System.Val_Util is
  27.  
  28.    ----------------------
  29.    -- Normalize_String --
  30.    ----------------------
  31.  
  32.    procedure Normalize_String
  33.      (S    : in out String;
  34.       F, L : out Positive'Base)
  35.    is
  36.    begin
  37.       F := S'First;
  38.       L := S'Last;
  39.  
  40.       --  Scan for leading spaces
  41.  
  42.       while F <= L and then S (F) = ' ' loop
  43.          F := F + 1;
  44.       end loop;
  45.  
  46.       --  Check for case when the string contained no characters
  47.  
  48.       if F > L then
  49.          raise Constraint_Error;
  50.       end if;
  51.  
  52.       --  Scan for trailing spaces
  53.  
  54.       while S (L) = ' ' loop
  55.          L := L - 1;
  56.       end loop;
  57.  
  58.       if S (F) /= ''' then
  59.  
  60.          --  Upper case any lower case characters.
  61.          --  This needs to be expanded to handle Latin-1 upper half ???
  62.  
  63.          for J in F .. L loop
  64.             if S (J) in 'a' .. 'z' then
  65.                S (J) := Character'Val (Character'Pos (S (J)) - 32);
  66.             end if;
  67.          end loop;
  68.       end if;
  69.  
  70.    end Normalize_String;
  71.  
  72.    ---------------
  73.    -- Scan_Sign --
  74.    ---------------
  75.  
  76.    procedure Scan_Sign
  77.      (Str   : String;
  78.       Ptr   : access Positive'Base;
  79.       Max   : Positive'Base;
  80.       Minus : out Boolean;
  81.       Start : out Positive)
  82.    is
  83.       P : Natural := Ptr.all;
  84.  
  85.    begin
  86.       --  Deal with case of null string (all blanks!). As per spec, we
  87.       --  return with Ptr > Max (i.e. no change, since Ptr already > Max)
  88.  
  89.       if P > Max then
  90.          return;
  91.       end if;
  92.  
  93.       --  Scan past initial blanks
  94.  
  95.       while Str (P) = ' ' loop
  96.          P := P + 1;
  97.  
  98.          if P > Max then
  99.             Ptr.all := P;
  100.             raise Constraint_Error;
  101.          end if;
  102.       end loop;
  103.  
  104.       Start := P;
  105.  
  106.       --  Remember an initial minus sign
  107.  
  108.       if Str (P) = '-' then
  109.          Minus := True;
  110.          P := P + 1;
  111.  
  112.          if P > Max then
  113.             Ptr.all := Start;
  114.             raise Constraint_Error;
  115.          end if;
  116.  
  117.       --  Skip past an initial plus sign
  118.  
  119.       elsif Str (P) = '+' then
  120.          Minus := False;
  121.          P := P + 1;
  122.  
  123.          if P > Max then
  124.             Ptr.all := Start;
  125.             raise Constraint_Error;
  126.          end if;
  127.  
  128.       else
  129.          Minus := False;
  130.       end if;
  131.  
  132.       Ptr.all := P;
  133.    end Scan_Sign;
  134.  
  135.    -------------------
  136.    -- Scan_Exponent --
  137.    -------------------
  138.  
  139.    function Scan_Exponent
  140.      (Str  : String;
  141.       Ptr  : access Positive'Base;
  142.       Max  : Positive'Base;
  143.       Real : Boolean := False)
  144.       return Integer
  145.    is
  146.       P : Natural := Ptr.all;
  147.       M : Boolean;
  148.       X : Integer;
  149.  
  150.    begin
  151.       if P >= Max
  152.         or else (Str (P) /= 'E' and then Str (P) /= 'e')
  153.       then
  154.          return 0;
  155.       end if;
  156.  
  157.       --  We have an E/e, see if sign follows
  158.  
  159.       P := P + 1;
  160.  
  161.       if Str (P) = '+' then
  162.          P := P + 1;
  163.  
  164.          if P > Max then
  165.             return 0;
  166.          else
  167.             M := False;
  168.          end if;
  169.  
  170.       elsif Str (P) = '-' then
  171.          P := P + 1;
  172.  
  173.          if P > Max or else not Real then
  174.             return 0;
  175.          else
  176.             M := True;
  177.          end if;
  178.  
  179.       else
  180.          M := False;
  181.       end if;
  182.  
  183.       if Str (P) not in '0' .. '9' then
  184.          return 0;
  185.       end if;
  186.  
  187.       --  Scan out the exponent value as an unsigned integer. Values larger
  188.       --  than (Integer'Last / 10) are simply considered large enough here.
  189.       --  This assumption is correct for all machines we know of (e.g. in
  190.       --  the case of 16 bit integers it allows exponents up to 3276, which
  191.       --  is large enough for the largest floating types in base 2.
  192.  
  193.       X := 0;
  194.  
  195.       loop
  196.          if X < (Integer'Last / 10) then
  197.             X := X * 10 + (Character'Pos (Str (P)) - Character'Pos ('0'));
  198.             P := P + 1;
  199.          end if;
  200.  
  201.          exit when P > Max;
  202.  
  203.          if Str (P) = '_' and then P < Max then
  204.             P := P + 1;
  205.          end if;
  206.  
  207.          exit when P > Max or else Str (P) not in '0' .. '9';
  208.       end loop;
  209.  
  210.       if M then
  211.          X := -X;
  212.       end if;
  213.  
  214.       Ptr.all := P;
  215.       return X;
  216.  
  217.    end Scan_Exponent;
  218.  
  219.    --------------------------
  220.    -- Scan_Trailing_Blanks --
  221.    --------------------------
  222.  
  223.    procedure Scan_Trailing_Blanks (Str : String; P : Positive) is
  224.       Max : constant Natural := Str'Last;
  225.  
  226.    begin
  227.       for J in P .. Str'Last loop
  228.          if Str (P) /= ' ' then
  229.             raise Constraint_Error;
  230.          end if;
  231.       end loop;
  232.    end Scan_Trailing_Blanks;
  233.  
  234. end System.Val_Util;
  235.